
# load an r library, downloading if necesary
library0 <- function(s)
{
	if(s %in% rownames(installed.packages()) == FALSE) {install.packages(s,repos='http://cran.us.r-project.org')}
	require(s,character.only=TRUE)
}

library0("plyr")
library0("readxl")
library0("fastmatch")
library0("stringr")
library0("igraph")

print0 <- function(s1,s2=logical(0))
{
	if(length(s2) == 0)
	{
		print(s1)
		flush.console()
	} else {
		print(paste(s1,": ",s2,sep=""))
		flush.console()
	}
}

apply0 <- function(func1,x,subset=numeric(0),by=numeric(0),bys=numeric(0),...)
{
	if(length(subset) == 0) {
		x1 <- subset(x,!is.na(x))
		if(length(by) != 0) by1 <- subset(by,!is.na(x))
	} else if(length(subset) != length(x)) {
		# Error
		stop("Incompadible Dimensions")
	} else {
		x1 <- subset(x,subset&!is.na(x))
		if(length(by) != 0) by1 <- subset(by,subset&!is.na(x))
	}
	if(length(x1) == 0) {
		NA
	} else {
		if(length(by) == 0) {
			func1(x1,...)
		} else {
			if(length(bys) == 0) bys <- sort(unique(by1))
			
			# there has to be a better way than this...
			dat1 <- cbind(x1,by1)[order(by1),]
			J <- length(unique(by1))
			start <- rep(NA,J)
			start[1] <- 1
			tab1 <- table(by1)
			if(J > 1) {
				for(j in 2:J) start[j] <- start[j-1] + tab1[j-1]
				end <- c(start[2:J]-1,length(x1))
			} else {
				end <- length(x)
			}
			ret <- rep(NA,length(bys))
			for(j in 1:J) {
				k <- fmatch(dat1[start[j],2],bys)
				if(!is.na(k)) ret[k] <- func1(as.numeric(dat1[start[j]:end[j],1]),...)
			}
			names(ret) <- bys
			ret
		}
	}
}

mean0 <- function(x,w=numeric(0),subset=numeric(0),by=numeric(0),bys=numeric(0),se=FALSE,ci=FALSE)
{
	n <- length(x)
	if(length(subset) != 0 & length(subset) != n) stop("error in mean0 -- incompadible dimensions (subset)")
	if(length(w) != 0 & length(w) != n) stop("error in mean0 -- incompadible dimensions (w)")
	if(!se & !ci) {
		if(length(w) == 0) {
			apply0(mean,x,subset,by,bys)
		} else {
			if(length(subset) == 0) {
				subset1 <- !is.na(x) & !is.na(w)
			} else {
				subset1 <- !is.na(x) & !is.na(w) & subset
			}
			apply0(mean,w*x,subset1,by,bys) / apply0(mean,w,subset1,by,bys)
		}
	} else {
		ret <- list()
		if(length(w) == 0) {
			ret$est <- apply0(mean,x,subset,by,bys)
			se1 <- ret$se <- (var0(x,subset,by,bys) / n0(x,subset,by,bys))^.5
		} else {
			if(length(subset) == 0) {
				subset1 <- !is.na(x) & !is.na(w)
			} else {
				subset1 <- !is.na(x) & !is.na(w) & subset
			}
			W = apply0(sum,w,subset1,by,bys)
			ret <- list()
			ret$est <- apply0(sum,w*x,subset1,by,bys) / W 
			se1 <- (var0(w*x,subset1,by,bys) * n0(w*x,subset1,by,bys) / W^2)^.5
		}
		if(se) ret$se <- se1
		if(ci) ret$ci <- c(ret$est - 1.96 * se1,ret$est + 1.96 * se1)
		ret
	}
}

max0 <- function(x,subset=numeric(0),by=numeric(0),bys=numeric(0))
{
	apply0(max,x,subset,by,bys)
}

min0 <- function(x,subset=numeric(0),by=numeric(0),bys=numeric(0))
{
	apply0(min,x,subset,by,bys)
}

check.integer <- function(x)
{
    x == round(x)
}

str_split_vec <- function(x,sep)
{
	temp <- str_split(x,sep)
	n <- length(temp)
	m <- length(temp[[1]])
	res <- matrix(rep(NA,n*m),ncol=m)
	for(i in 1:n)
	{
		if(length(temp[[i]]) != m) stop("error in str_split_vec -- columns are not equal size")
		for(j in 1:m) res[i,j] <- temp[[i]][j]
	}	
	res
}

# sample size for 1-D statistics
n0 <- function(x,subset=numeric(0),by=numeric(0),bys=numeric(0))
{
	if(length(subset) == 0) {
		subset1 <- subset(x,!is.na(x))
		if(length(by) != 0) by1 <- subset(by,!is.na(x))
	} else if(length(subset) != length(x)) {
		# Error
		stop("Incompadible Dimensions")
	} else {
		subset1 <- subset(x,subset&!is.na(x))
		if(length(by) != 0) by1 <- subset(by,subset&!is.na(x))
	}
	if(length(subset1) == 0) {
		0
	} else {
		if(length(by) == 0) {
			sum(!is.na(subset1))
		} else {
			if(length(bys) == 0) bys <- sort(unique(by1))
			n <- length(bys)
			ret <- rep(NA,n)
			for(i in 1:n)
			{
				if(length(subset(subset1,by1==bys[i])) > 0) {
					ret[i] <- sum(!is.na(subset(subset1,by1==bys[i])))
				}
			}
			names(ret) <- bys
			ret[is.na(ret)] <- 0
			ret
		}
	}
}